home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0043_ScreenBuffer Object.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  2KB  |  122 lines
  1. {
  2. From: STEFAN XENOS
  3. Subj: ScreenBuffer Object
  4.  
  5. Notes:
  6.   - 0,0 is recognised as the top-left corner of the screen.
  7.   - They seem to work perfectly when only popping one thing up at once.
  8. }
  9.  
  10. Uses Crt;
  11.  
  12. Type
  13.  TScreenBuf = Object
  14.   Constructor Init (NewX,NewY,NewHeight,NewWidth:Byte);
  15.   Destructor Done;
  16.   Procedure KillBuffer; Virtual;
  17.   Procedure Clip;
  18.   Procedure Paste;
  19.   Private
  20.    Buffer :Pointer;
  21.    Size :Byte;
  22.    x,
  23.    y,
  24.    Height,
  25.    Width :Byte;
  26.  end;
  27.  
  28. Var
  29.  MaxX,
  30.  MaxY :Byte;
  31.  ScreenSeg :Word;
  32.  
  33. Procedure GoXY (x,y:Byte);
  34. Begin
  35.  gotoXY (x+1,y+1);
  36. end;
  37.  
  38. Procedure FillWith (aChar:Char);
  39. Var
  40.  offset:Word;
  41. Begin
  42.  ClrScr;
  43.  For offset := 0 to maxx*maxy
  44.   do move (aChar,Ptr (ScreenSeg,offset*2)^,1);
  45. End;
  46.  
  47. {TScreenBuf}
  48. Constructor TScreenBuf.Init (NewX,NewY,NewHeight,NewWidth:Byte);
  49. Begin
  50.  x := newx;
  51.  y := newy;
  52.  height := newheight;
  53.  width := newwidth;
  54.  Buffer := nil;
  55.  KillBuffer;
  56. End;
  57.  
  58. Destructor TScreenBuf.Done;
  59. Begin
  60.  KillBuffer;
  61. End;
  62.  
  63. Procedure TScreenBuf.KillBuffer;
  64. Begin
  65.  If Buffer <> nil
  66.   then FreeMem (Buffer,Size);
  67.  Size := 0;
  68.  Buffer := nil;
  69. End;
  70.  
  71. Procedure TScreenBuf.Clip;
  72. Var
  73.  ScanY :Byte;
  74. Begin
  75.  KillBuffer;
  76.  Size := Height*Width*2;
  77.  GetMem (Buffer,Size);
  78.  For ScanY := 0 to Height
  79.   do begin
  80.    Move (Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,
  81.     Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,Width*2);
  82.   end;
  83. End;
  84.  
  85. Procedure TScreenBuf.Paste;
  86. Var
  87.  ScanY :Byte;
  88. Begin
  89.  For ScanY := 0 to Height
  90.   do begin
  91.    Move (Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,
  92.     Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,Width*2);
  93.   end;
  94. End;
  95.  
  96. Var
  97.  Clip :TScreenBuf;
  98.  
  99. Begin
  100.  if Lastmode = Mono
  101.   then screenSeg := $B000          {Mono}
  102.  else screenSeg := $B800;          {Colour}
  103.  if Lastmode
  104.   and font8x8 <> 0
  105.   then MaxY := 50                  {25X80}
  106.  else MaxY := 25;                  {50X80}
  107.  MaxX := 80;
  108.  
  109.  textcolor (darkgray);
  110.  textbackground (lightgray);
  111.  FillWith (#178);
  112.  textcolor (yellow);
  113.  textbackground (blue);
  114.  Clip.Init (10,10,1,21);
  115.  Clip.Clip;
  116.  goXY (10,10);
  117.  Write ('Hit ENTER to continue');
  118.  While Readkey <> #13 do;
  119.  Clip.Paste;
  120.  Clip.Done;
  121. End.
  122.